home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / autolb.zip / AUTOLB.LSP
Text File  |  1990-01-14  |  6KB  |  176 lines
  1.  
  2. ;AUTOLBRK.LSP
  3. ;***************************************************************
  4. ;File: AUTOLBRK.LSP Copyright (C) Dan Hamilton 1988
  5. ;                         
  6. ;Function to automatically, without user interaction, search a drawing for any
  7. ;block(s) (in a list), on all lines, and measure the width of the block at the
  8. ;points of intersection with the line and then break the line. This will work at
  9. ;any Zoom size (viewsize).
  10. ;Developed for a particular application involving a lighting designers use of
  11. ;lighting instruments on pipes, this function can easily be adapted to any blocks
  12. ;on any lines. 
  13. ;
  14. ;The idea for this was inspired by BREAKL.LSP by Eliot Shanabrook and John
  15. ;Intorcio.  BREAKL works terrific, but often lights are
  16. ;moved around during creation of the drawing, and I was asked to help find a way
  17. ;to break the intrument-intersecting lines automatically when the drawing was
  18. ;completed.
  19. ;
  20. ;I would be glad to hear any suggestions as how to improve the code on this
  21. ;function, I know it works but I'm sure it could be better as this is my first
  22. ;Autolisp program.
  23. ;
  24. ;Follow some random notes on the program:
  25. ;
  26. ;It's big. (vmon) is included to save memory.
  27. ;
  28. ;(LList) is the list of block names, in this case lighting instr.
  29. ;
  30. ;(the number 0.003249 used with the VIEWSIZE variable to adjust
  31. ;the breakpoints was found by dividing the STEP1 variable amount by the current
  32. ;viewsize when I first solved the problem.
  33. ;
  34. ;The SETTINGS in use were Architect. Using AUTOCAD VER. 9.
  35. ;
  36. ;Enjoy....
  37. ;*************************************************************************
  38. ;CREATE THE WINDOW FROM THE LINE ENDS
  39. ;
  40. (VMON)
  41. (DEFUN MAKW()
  42. (setq *lines* (+ *lines* 1))
  43. (setq pt10 (cdr (assoc 10 eas))); SET THE POINTS TO THE
  44. (setq pt11 (cdr (assoc 11 eas))); ENDS OF THE LINE
  45. (SETQ AN1 (ANGLE PT10 PT11))
  46. ;
  47. ; AND CREATE THE SELECTION SET 
  48. ;
  49. (SETQ SSET (SSGET "C" pt10 pt11))
  50.     (setq pt10 nil)
  51.     (setq pt11 nil)
  52.     (setq count 0)
  53. (if sset (loop)) ; If we got anything....
  54. ) ; END FUNCTION MAKW
  55. ;
  56. ;NOW CHECK THE SET FOR LIGHT INSTRUMENTS
  57. ;
  58. (DEFUN LOOP()
  59. (while (>=(SSLENGTH SSET) (+ COUNT 1))
  60. (SETQ INSTR(CDR(ASSOC 2(ENTGET(SSNAME SSET COUNT)))))    
  61. ;
  62. (IF (OR (MEMBER INSTR LLIST) (/= INSTR NIL))
  63.         (FILT) ; check for LIGHTS
  64.         (PROGN
  65.         (SETQ COUNT (1+ COUNT))
  66.         (SETQ INSTR NIL)
  67.         (LOOP)
  68.         ) ; END PROGN
  69.     ) ; END IF
  70.     (SETQ COUNT (+ COUNT 1))
  71. ) ; end WHILE
  72. ) ; END FUNCTION LOOP
  73. ;
  74. (DEFUN FILT()
  75.      (setq *lights* (+ *lights* 1)) 
  76.     (SETQ PTI (CDR (ASSOC 10 (ENTGET (SSNAME SSET COUNT)))))
  77.     (princ (strcat "\nCurrently processing pipe # "(rtos (float
  78. *lines*) 2 0)",Instrument # "(rtos (float *lights*) 2 0) " labeled "instr))    
  79. ;
  80. ;the insertion point of the block (pti) is on the line(eas)
  81. ;
  82. (setq step 0.5) ; initialize the step size
  83. (searchr)    ; go right
  84. (setq step 0.5)    ; reset
  85. (setq an2 (+ AN1 (DTR 180))) ; flip the angle 180 **DTR NOT DEFINED HERE**
  86. (searchl)    ; and go left                        **INCLUDED IN ACAD.LSP**
  87. (command "break" ptl ptr)
  88. (setq step nil)
  89. (setq step1 nil)
  90. (setq newptr nil)        
  91. (setq ptr nil)
  92. (setq newptl nil)
  93. (setq ptl nil)
  94. (setq COUNT (1+ COUNT))
  95. (LOOP)
  96. ) ; END FUNTION FILT
  97. ;
  98. (DEFUN SEARCHR()
  99. (setq newptr (polar pti an1 step)) ; new point to the right of pti
  100. (if (NULL (osnap newptr "ins")); find the block
  101.         (progn ;                  if nothing there, try again
  102.         (setq step(+ step 0.3))
  103.         (searchr)
  104.         ); end progn
  105. ); end if
  106. (setq step1 0.1)
  107. (while (and (osnap newptr "ins")) ; if still the block,keep looking
  108.     (setq newptr (polar pti an1 (+ step step1)))
  109.     (setq step1 (+ step1 0.1))
  110. ) ; end while
  111. (setq step1 (+ step1 (* 0.003249 (getvar "viewsize")))) 
  112. ; adjust the step needed to get past the block's line thickness
  113. ; on any given viewsize
  114. ;                                 
  115. (setq ptr (POLAR PTI AN1 (+ STEP STEP1))) ; SET BREAK POINT
  116. ) ; end function searchr
  117. ;
  118. ;
  119. (DEFUN SEARCHL()
  120. (setq newptl (polar pti an2 step)) ; new point to the left of newpti
  121. (if (NULL (osnap newptl "ins"))
  122.         (progn ;                  if nothing there, try again
  123.         (setq step(+ step 0.3))
  124.         (searchl)
  125.         ); end progn
  126. ); end if
  127. (setq step1 0.1)
  128. (while (and (osnap newptl "ins"))
  129.     (setq newptl (polar pti an2 (+ step step1)))
  130.     (setq step1 (+ step1 0.1))
  131. ) ; end while
  132. (setq step1 (+ step1 (* 0.003249 (getvar "viewsize"))))
  133. (SETQ PTL (POLAR PTI AN2 (+ STEP STEP1)))
  134. ) ; end function searchl
  135. ;
  136. ;
  137. (DEFUN C:BREAKL()
  138. (setvar "CMDECHO" 0)
  139. (COMMAND "SNAP" OFF)
  140. (VMON)
  141. (SETQ PICSIZ(GETVAR "PICKBOX"))
  142. (SETVAR "PICKBOX" 1)
  143. (setq vz(getvar "viewsize"))
  144. (setq apsave (getvar "aperture"))
  145. (command "aperture" 1)
  146. (terpri)
  147. (SETQ LLIST (list "LEKO4" "LEKO4B" "LEKO9" "LEKO9B" "LEKO10"
  148. "LEKO12" "LEKO12B" "LEKO16" "LEKO16B" "LEKO22" "LEKO22B" "FR6"
  149. "FR6B" "FR8" "FR8B" "FR10" "FR10B" "FR14" "FR14B"))
  150. (setq *lines* 0)
  151. (setq *lights* 0)
  152. ;
  153. (setq e(entnext))
  154. ;
  155. (while e
  156.     (setq eas (entget e))
  157.     (setq en (CDR (ASSOC 0 EAS)))
  158.     (if (= en "LINE")
  159.         (progn        
  160.             (MAKW)
  161.             (SETQ E (ENTNEXT E))
  162.             ) ; END PROGN
  163.             (SETQ E (ENTNEXT E))
  164.     ) ; END IF
  165. ) ; end while
  166. (redraw)
  167. (princ (strcat "\nProcessed "(rtos (float *lines*) 2 0) "Pipes 
  168. and "(rtos (float *lights*) 2 0)" instruments."))
  169. (SETQ LLIST NIL)
  170. (SETVAR "APERTURE" APSAVE)
  171. (SETVAR "PICKBOX" PICSIZ)
  172. (terpri)
  173. ) ; END FUNCTION BREAKL   
  174. ;
  175. ;